; this file is dSupport.txt
; Mon Feb 15, 1988 10:22:13 menus
; Thu Feb 18, 1988 00:24:50 redo the control routine structure
;			    key events are now subroutines
; Wed Mar 30, 1988 13:37:36 opener routine
; Thu Apr 07, 1988 16:00:59 nested loads
; Mon Apr 18, 1988 14:06:37 restructure variables, echo, version, pblk in d4
; Mon Apr 25, 1988 15:10:34 macros
; Fri Apr 29, 1988 10:36:59 cursor change handler
; Sun May 01, 1988 10:40:36 fix emptyFS
; Tue May 10, 1988 01:28:38 ?terminal now writes event record to pad
; Sat Aug 08, 1992 19:26:00 remove xpect emitcode, add form

; ----- Mac Data ------

theWindow:	DC.L	0		; the DA's wptr & stuff
    WContRect:	DC.W	0,0
    WSize:	DC.W	WHeight,WWidth

Activate:	DC.W	drop-base	; drop act/deact flag
Update:		DC.W	curs-base
Button:		DC.W	beep-base
YourMenu:	DC.W	menus-base
Runner:		DC.W	null-base
Closer:		DC.W	null-base
Version:	DC.W	doabout-base	; the about thingy
Opener:		DC.W	prompt-base	; open routine 3/30/88
Echo:		DC.W	-1
MyID:		DC.W	0
KeyDown:	DC.W	inKey-base	; text input
Cursor:		DC.W	null-base

oldSSize:	DC.W	0
oldStackH:	DC.L	0

TextO:		DC.L	0
TextE:		DC.L	0
TextH:		DC.L	0
FStack:		DCB.L	5,0		; text block handles
FOfsets:	DCB.L	5,0		; text block offsets
FEnds:		DCB.L	5,0		; text block ends
FSPtr:		DC.W	-4		; file stack pointer

Events:		DC.W	return-base	; null event
		DC.W	buttDnEvt-base
		DC.W	return-base	; button up
		DC.W	keyDnEvt-base
		DC.W	return-base	; key up
		DC.W	keyDnEvt-base	; auto key
		DC.W	UpdateEvt-base
		DC.W	return-base	; disk inserted
		DC.W	ActivateEvt-base
		
Registers:	DCB.L	6,0		; save Dict/Counter/DP-IS/PS
PStackH:	DC.L	0

oldKeyDown:	DC.W	0		; hold key handler addr during key
Scratch:	DC.L	0

Menus:		DC.W	emenu-base
		DC.W	emenu-base
EMenu:		DC.W	beep-base	; undo
		DC.W	null-base	; -
		DC.W	beep-base	; cut
		DC.W	beep-base	; copy
		DC.W	paste-base	; paste
		DC.W	beep-base	; clear

; ----- Forth's Data ------

TermBuf:	DCB.B	84,32		; the input line buffer
IntA7:		DC.L	0		; applications rStack
RZero:		DC.L	0		; empty rStack
UFlow:		DC.L	0		; pstack underflow buffer (2bytes)
SZero:		DC.L	0		; empty pStack
Expand:		DC.L	0		; abs.addr in locked DRVR
FreePt:		DC.W	DictEnd-base	; "here"'s relative addr
FreeSz:		DC.W	base+32767-dictend	; number of bytes available
DictPt:		DC.W	task-theLink	; last word defined
NBase:		DC.W	10		; number base
Held:		DC.W	0		; HLD address
DoesAddr:	DC.L	0		; "does>" jump address
fcolon:		DC.B	0		; defining flag
fimmed:		DC.B	0		; immediate definition flag	
fneg:		DC.B	0		; negative sign flag
fint:		DC.B	$80		; key or clipboard
fmacro:		DC.W	0		;   macro flag+filler
Form:		DC.L	$FFFF0007	; decaform record

DictControl:	; ----- Control routine ------
	JSR	SetFRegs		; set the Forth registers	
	MOVE.L	A7,IntA7-base(BP)	; put return address in IntA7
	SUBA.L	#16,A7			; allocate a underflow buffer
	MOVE.L	A7,Rzero-base(BP)
	MOVE.L	theWindow-base(BP),-(SP)
	_SetPort			; set this window

	MOVE.L	D4,A0			; A0 has the param block's address
	MOVE	csCode(A0),D0		; d0 has the message

	; Event Message
	CMPI	#accEvent,D0		; event message?
	BNE.S	@0
	MOVEA.L	csEvent(A0),A0		; get the event record
	MOVE	evtNum(A0),D0		; get event in D0
	ANDI	#$0F,D0
	ADD	D0,D0
	LEA	Events-base(BP),A1	; jump to: ...
	MOVE	0(A1,D0.W),D0		;  ... ActivateEvt, ButtDnEvt, ...
	JMP	0(BP,D0.W)		;  ... UpDateEvt or KeyDnEvt
	
	; Idle Message
    @0:	CMPI	#accRun,D0		; periodic run message?
	BNE.S	@1
	MOVE	Runner-base(BP),D0
	BRA.S	@5			; jump to the idle handler
	
	; cursor message
    @1:	CMPI	#accCursor,D0		; change cursor message?
	BNE.S	@2
	MOVE	cursor-base(BP),D0
	BRA.S	@5			; jump to the cursor handler
	
	; Menu Message
    @2:	CMPI	#accMenu,D0		; menu message
    	BNE.S	@3
	MOVE	csMenu(A0),D0		; D0 has the item number
	SUBQ	#1,D0			; D0 has the item index
	ADD	D0,D0			; D0 has menu list offset
	MOVE	Yourmenu-base(BP),D1	; D1 has menus relative addr
	BRA.S	@4			; execute the menu

	; Edit message
    @3:	CMPI	#accUndo,D0		; edit menu message?
	BMI.S	return
	SUBI	#accUndo,D0		; normalize message# to 0-5
	ADD	D0,D0			; D0 has offset into emenu
	MOVE	Yourmenu-base(BP),D1	; D1 has menus relative addr
	ADDQ	#2,D1			; D1 has menus+2 rel addr

    @4:	MOVE	0(BP,D1.W),D1		; D1 has emenu rel addr
	ADD	D1,D0			; D0 has emenu+offset rel addr
	MOVE	0(BP,D0.W),D0		; D0 has the handler' rel addr
    @5:	JSR	0(BP,D0.W)		; execute subroutine

Return:	JSR	SaveFRegs-base(BP)	; save the current forth registers
	MOVE.L	IntA7-base(BP),A7	; restore the return address
	RTS				; and go back to the DRVR

; First Line Event Handlers

ActivateEvt:
	MOVE	evtMeta(A0),-(PS)
	ANDI	#1,(PS)
	MOVE	Activate-base(BP),D0
	BRA.S	revt

ButtDnEvt:
	MOVE	Button-base(BP),D0
  revt:	JSR	0(BP,D0.W)
	BRA.S	return

UpDateEvt:
	MOVE.L	thewindow-base(BP),-(SP)
	MOVE.L	(SP),-(SP)
	_BeginUpdate
	MOVE	update-base(BP),D0
	JSR	0(BP,D0.W)
	_EndUpdate
	BRA.S	return
	
KeyDnEvt:
	MOVE.W	evtASCII(A0),-(PS)	; push key data
	MOVE	Keydown-base(BP),D0
	JSR	0(BP,D0.W)		; jump to the vector
 kDone:	BSR.S	Curs			; draw the cursor
	BRA.S	return

; Un-named subroutines

SaveFRegs:
	LEA	Registers-base(BP),A0
	MOVEM.L	D6-D7/A2-A4/A6,(A0)
	RTS

SetFRegs:	; restore the forth registers
	LEA	Registers,A0
	MOVEM.L	(A0),D6-D7/A2-A4/A6
	RTS
		
TextNormal:
	_PenNormal			; 1X1, black, patcopy
	MOVE	#4,-(SP)		; Monaco
	_TextFont
	MOVE	#0,-(SP)		; plain text
	_TextFace
	MOVE	#9,-(SP)		; 9 point
	_TextSize
	MOVE	#0,-(SP)		; srcCopy
	_TextMode
	RTS	
	
NoCurs:	MOVE	#10,-(SP)		; SrcXor mode
	_PenMode
  Curs:	MOVE.L	#$00000006,-(SP)	; move 6 pixels to the right
	_Move
	MOVE.L	#$0000FFFA,-(SP)	; draw 6 pixels to the left
	_Line
	_PenNormal
	RTS

altKey:	BSR.S	TextNormal		; font, mode, size etc
	BSR.S	NoCurs			; erase the cursor
	MOVE	oldKeyDown-base(BP),KeyDown-base(BP) ; set old key vector
	BSR.S	RestoreRStack		; put pforth addrs on rstack
	MOVE.L	oldStackH-base(BP),A0
	MOVEQ	#0,D0
	_SetHandleSize			; shrink old stack data block
	ANDI	#$FF,(PS)		; mask out ascii
	RTS				; return from "key"

RestoreRStack:
	MOVE.L	(SP)+,A1		; save calling address
	MOVE.L	oldStackH-base(BP),A0
	MOVE.L	(A0),A0			; get addr of old stack data block
	MOVEQ	#0,D0
	MOVE	oldSSize-base(BP),D0	; get size of block to move
	ADD.L	D0,A0
    @0: MOVE.L	-(A0),-(SP)
	SUBQ.L	#4,D0
	BGT.S	@0
	JMP	(A1)			; return to calling address

QTCode:		; "?terminal" code
	CLR	-(SP)			; ?terminal's routine
	MOVE	#40,-(SP)		; test just for keypresses
	PEA	40(DP)			; put the data at 'pad'
	_EventAvail
	MOVE	(SP)+,-(PS)
	MOVE.L	#$0000FFFF,D0
	_FlushEvents			; all events out!
	RTS

KeyCode:	; "key" code
	MOVE.L	RZero-base(BP),D5
	SUB.L	SP,D5
	MOVEQ	#0,D0
	MOVE	D5,D0
	MOVE	D0,oldSSize-base(BP)	; set old stack size
	MOVE.L	oldStackH-base(BP),A0
	_SetHandleSize
	MOVE.L	(A0),A0			; A0 points to old stack data block
    @0:	MOVE.L	(SP)+,(A0)+		; save RStack
	SUBQ	#4,D5
	BGT.S	@0
	MOVE	KeyDown-base(BP),oldKeyDown-base(BP)  ; save the old keydown
	MOVE	#altKey-base,keydown-base(BP)	; reset key handler
	JMP	kDone-base(BP)			; return to application

ClearTermBuf:
	MOVEQ	#76,D0
	LEA	TermBuf-base(BP),IS
    @0:	MOVE.L	#$20202020,0(IS,D0)	; fill line buffer with blanks
	SUBQ.B	#4,D0
	BGE.S	@0
	RTS

EmptyFS: ; clear pending loads from the file stack
	TST	fsptr-base(BP)
	BMI.S	@1
	LEA	fstack-base(BP),A1
	MOVE	fsptr-base(BP),D0
	MOVE.L	0(A1,D0),A0
	CLR.L	0(A1,D0)
	MOVE.L	A0,D1			; dont try to dispose of nil handle*
	BEQ.S	@0			; *
	CMPA.L	TextH-base(BP),A0
	BEQ.S	@0
	_DisposHandle
    @0:	SUBQ	#4,fsptr-base(BP)
	BRA.S	emptyfs
    @1:	RTS

Paste:	JSR	nocurs-base(BP)
	CLR.L	-(SP)
	MOVE.L	TextH-base(BP),-(SP)	; handle to the scrap data
	MOVE.L	#'TEXT',-(SP)
	PEA	TextO-Base(BP)
	_GetScrap
	MOVE.L	(SP)+,TextE-base(BP)	; put the length at TextE
	MOVE.L	TextH-base(BP),A0	; get a handle to the scrap data
	MOVE.L	(A0),D0			; derefrence the scrap handle
	MOVE.L	D0,TextO-base(BP)	; set TextO to start of scrap data
	ADD.L	D0,TextE-base(BP)	; set TextE to end of scrap data
	_HLock				; don't let data move during paste
	CLR	fsptr-base(BP)
	MOVE.L	TextH-base(BP),fstack-base(BP)
	MOVE.L	TextO-base(BP),fofsets-base(BP)
	MOVE.L	TextE-base(BP),fends-base(BP)
    go:	CLR.B	fint-base(BP)		; leave keyboard mode
	JMP	CRet-base(BP)		; get next line

Pasting:
	JSR	ClearTermBuf-base(BP)
	CLR.L	D5			; clear the character count
	CLR.L	D0			; and the character
	MOVE.L	TextO-base(BP),A0	; set the input address
    @0:	MOVE.B	0(A0,D5.W),D0		; BEGIN  get a character
	CMP.B	#CR,D0			;     is it not a CR?
	BEQ.S	@1
	CMPI.B	#78,D5			;     or 78 characters in buffer
	BGE.S	@1			; WHILE
    	MOVE.B	D0,0(IS,D5)		;     stash it into buffer
	ADDQ.B	#1,D5			;     increment count
	BRA.S	@0			; REPEAT
    @1:	ADDQ.B	#1,D5			; increment count
	MOVE.B	#CR,0(IS,D5)		; stash CR into buffer
	MOVE	D5,D0			; preserve count for TYPE
	ADD.L	TextO-base(BP),D0
	MOVE.L	D0,TextO-base(BP)	; TextO=TextO+char.count
	CMP.L	TextE-base(BP),D0	; IS the block done (TextO³TextE)?
	BMI.S	tandr			; just type and return if not.
	
	MOVE	fsptr-base(BP),D0
	LEA	fstack-base(BP),A0
	MOVE.L	0(A0,D0.W),A0
	_HUnlock			; unlock the block
	CMPA.L	TextH-base(BP),A0
	BEQ.S	@2			; keep the scrap block

	_DisposHandle			; dispose of loaded blocks
    @2:	SUBQ	#4,fsptr-base(BP)	; pop fstack
	BMI.S	@3			; branch if no pending loads

	MOVE	fsptr-base(BP),D0
	LEA	fofsets-base(BP),A0	; set TextO to (fofsets+fsptr)
	MOVE.L	0(A0,D0.W),TextO-base(BP)
	LEA	fends-base(BP),A0
	MOVE.L	0(A0,D0.W),TextE-base(BP)
	BRA.S	tandr

    @3:	BSET.B	#7,fint-base(BP)	; set keyboard mode
 tandr:	TST	echo-base(BP)
	BNE.S	@4
	RTS
	
    @4:	JSR	tib-base(BP)
	MOVE	D5,-(PS)
	JSR	type-base(BP)
	JMP	doCR-base(BP)		; TIB count TYPE CR ;

DoAbout:
	CLR.L	-(SP)
	MOVE.L	#'p4TH',-(SP)
	MOVE	myid-base(BP),-(SP)	; Resource ID of p4TH
	_GetResource
	MOVE.L	(SP),A0
	MOVE.L	(A0),-(SP)		; text address
	_DrawString
	_ReleaseResource
	JMP	docr-base(BP)